package vm_info;

# This parses files which have the following elements - 
# which all must exist... It also checks to see if
# the programs specified exist, and if not errors too...

# <xml version="1.0" standalone="yes">
# <vmdef>
#	<name>kvm</name>
#	<os_supported>linux,solaris</os_supported>
#	<description>Kernal Virtual Machine</description>
#	<check>vmtools/check_kvm_installed</check>
#	<startup>vmtools/start_kvm_machine $$APPNAME</startup>
#	<shutdown>vmtools/stop_kvm_machine $$APPNAME</shutdown>
#	<poweroff>vmtools/poweroff_kvm_machine $$APPNAME</poweroff>
#	<migrate>vmtools/migrate_kvm_machine $$NEWNODE $$APPNAME</migrate>
#	<support_migrate>yes</support_migrate>
#	<migrate_transports>tcp(port=\d+) ssh(user=.*,nc=.*)</migrate_transports>
#	<probe>vmtools/probe_kvm_running %appname</probe>
# </vmdef>
#
# Interface also allows the above actinos to be performed too.
#
# The transport options (given in brackets after the name), are
# all considered optional.

use XML::Parser;
use Carp qw(cluck);
use clutils (to_bool);
use strict;

my $error_str=undef;
my $logmsg_hdlr=undef;
my $warnmsg_hdlr=undef;

sub error {
	return $error_str;
}

sub set_logmsg_hdlr {
	$logmsg_hdlr=$_[0];
}

sub set_warnmsg_hdlr {
	$warnmsg_hdlr=$_[0];
}

sub msg {
	if($_[0] eq "log" && defined($logmsg_hdlr)) {
		&{$logmsg_hdlr}($_[1]);
	}
	if($_[0] eq "warn" && defined($warnmsg_hdlr)) {
		&{$logmsg_hdlr}($_[1]);
	}
}

#########################################################################
# Class methods:							#
# ==============							#
# error - return latest error string or undef if everything was OK.	#
# set_logmsg_hdlr -  the routine to call to log a message - no logging	#
# 		     occurs if not set.					#
# set_warnmsg_hdlr - Issue a warning message via this routine - if	#
#		     available.						#
#########################################################################

#########################################################################
# 									#
# The new method will load in the object or set the error condition.	#
# Only following arguement is expect, and will not default it not set.	#
#									#
# filename	The name of the cluster configuration file.		#
#									#
#########################################################################

sub new {
local $vm_info::self;
local $vm_info::__chardata;
my $class=shift;
my $type=$_[0];

	if(!defined($type)) {
		cluck("Missing mandatory type argument.") if $::DEBUG;
		$error_str="Missing mandatory type argument.";
		return undef;
	}

	# The file in question will be in TRUECL_CFG/vm/type.xml
	my $file="$::ENV{TRUECL_CFG}/vm/$type.xml";
	
	if(! -e $file) {
		cluck("File '$file' does not exist.") if $::DEBUG;
		$error_str="File '$file' does not exist.";
		return undef;
	}
	if(! -f $file) {
		cluck("Object '$file' is not a regular file.") if $::DEBUG;
		$error_str="Object '$file' is not a regular file.";
		return undef;
	}

	#################################################################
	# Now load in the XML using the XML::Parser - not XML simple.	#
	#################################################################
	
	$vm_info::self={};
	my $p;
	$p = new XML::Parser(
			Handlers => { Start => \&lc_handle_start,
					End => \&lc_handle_end,
				       Char => \&lc_handle_char },
			ErrorContext => 5
		);
	$error_str=undef;
	$p->parsefile($file);
	if(defined($error_str)) {
		cluck($error_str) if $::DEBUG;
		return undef;
	}
	my @E=qw(support_migrate migrate_transports name os_supported description check startup poweroff shutdown migrate probe);
	my @M=();
	for my $ce (@E) {
		if(!exists($vm_info::self->{xml}->{$ce})) {
			push @M,$ce;
		}
	}
	if(@M) {
		cluck("Configuration file missing elements: " . join(",",@M)) if $::DEBUG;
		$error_str="Configuration file missing elements: " . join(",",@M);
		return undef;
	}
	bless($vm_info::self,$class);
	return $vm_info::self;
}

sub lc_handle_start {
my $parser=shift;
my $element=shift;
my %attrs=(@_);
my @context=$parser->context;
my @E=qw(support_migrate migrate_transports name os_supported description check startup poweroff shutdown migrate probe);

	$element="\l$element";
	$vm_info::__chardata="";

	return if $element eq "vmdef";
	if($context[0] ne "vmdef") {
		$error_str="Top level element '$context[0]' found - should be 'vmdef'.";
		$parser->finish;
		return;
	}
	
	if(! grep {$element eq $_} @E) {
		$error_str="Element '$element' unknown - should be one of: " . join(",",sort(@E));
		$parser->finish;
		return;
	}

	# Create empty element for this type...
	$vm_info::self->{xml}->{$element}="";
}

sub lc_handle_end {
my $parser=shift;
my $element=shift;
my @E=qw(support_migrate migrate_transports name os_supported description check startup poweroff shutdown migrate probe);

	$vm_info::__chardata =~ s/^\s+//g;	# Get rid of leading white
	$vm_info::__chardata =~ s/\s+$//g;	# Get rid of trailing white space
	$vm_info::__chardata =~ s/\n+$//g;	# Get rid of newlines white space
	if(grep {$element eq $_} @E) {
		$vm_info::self->{xml}->{$element}=$vm_info::__chardata;
	}
}

sub lc_handle_char {
my $parser=shift;
my $str=shift;

	$vm_info::__chardata.=$str;
	return ;
}

sub get_field {
my $self=shift;
my $f=shift;

	$error_str=undef;
	if(exists($self->{xml}->{$f})) {
		return $self->{xml}->{$f};
	}
	$error_str="Specified field '$f' does not exist!";
	return undef;
}

# Here we attempt to validate the transport settings. We
# assume the xml entry is in the format of:
#
# TRANSPORT(arg=pattern,...) TRANSPORT(arg=pattern,...)
#
# All args are assumed optional.
# args passed but not recognised give warnings, not errors.
#
# Returns (0,[errors],[warnings]) - can be (0,undef,undef)
#         (1,undef,undef) - vm does not define transports
#	  (2,errmsg,undef) - error has occurred
#

sub validate_transport($$) {
my $self=shift;
my $settings=shift;

	return(1,undef,undef) if $self->{xml}->{migrate_transports} eq "";
	my ($trans,$targs);
	if($settings =~ /\(/) {
		($trans,$targs)=($settings =~ /.*\((.*)\)/);
	} else {
		$trans=$settings;
		$targs="";
	}

	my @T=split(/\s+/,$self->{xml}->{migrate_transports});
	my $found=undef;
	for my $t (@T) {
		my ($name,$args);
		if($self->{xml}->{migrate_transports} =~ /\(/) {
			($name,$args)=($self->{xml}->{migrate_transports} =~ /(.*)\((.*)\)/);
		} else {
			$name=$self->{xml}->{migrate_transports};
			$args="";
		}
		if($name eq $trans) {
			$found=$args;
			last;
		}
	}
	if(!defined($found)) {
		return(2,"Transport '$trans' is unknown.",undef);
	}
	# found can be empty of last of known args...
	# TODO
	# need to add arg handling here...
	return(0,[],[]); # Ok
}

1;
